{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit ZipReader;

interface

uses
  Classes, SysUtils, ZipCommon, zstreamCustom, MiscUtils, Math;

type
  TStreamReadEvent = procedure(Sender: TStream; const Buffer; Count: Integer) of object;

  TInputFilterStream = class(TStream)
  private
    FSource: TStream;

    { how many bytes can be read from FSource, -1 = no limit }
    FLimit: Int64;

    { FBytesRead <= FLimit when FLimit <> -1 }
    FBytesRead: Int64;

    FOnRead: TStreamReadEvent;
  public
    constructor Create(Source: TStream; const Limit: Int64 = -1);

    function Read(var Buffer; Count: Longint): Longint; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;

    { unsupported operations }
    function Write(const Buffer; Count: Longint): Longint; override;
    procedure SetSize(NewSize: Longint); override;

    property OnRead: TStreamReadEvent read FOnRead write FOnRead;
  end;

  TZipReader = class
  private type
    TZipEntry = class
    private
      FHeader: TZipCentralFileHeader;
      FFileName: String;
    end;
    TZipEntryList = TGenericObjectList<TZipEntry>;
  private
    FInput: TStream;
    FDirOffset: Integer;
    FRawEntryStream: TInputFilterStream;
    FDecompressionStream: TDecompressionStream;
    FCrc32Filter: TInputFilterStream;
    FEntryStream: TStream;
    FCurrentEntry: TZipEntry;
    FEntries: TZipEntryList;
    FReading: Boolean;
    FCrc32: Cardinal;
    FHotEntryIndex: Integer;
    function GetEntryCount: Integer;
    function GetEntryFileNames(Index: Integer): String;
    function GetEntryStream: TStream;
    procedure Crc32FilterRead(Sender: TStream; const Buffer; Count: Integer);
  public
    constructor Create(Input: TStream);
    destructor Destroy; override;
    procedure OpenEntry(const FileName: String);
    procedure CloseEntry;
    function GetEntryIndexByFileName(const FileName: String): Integer;
    function FindEntryIndexByFileName(const FileName: String): Integer;

    property EntryCount: Integer read GetEntryCount;
    property EntryFileNames[Index: Integer]: String read GetEntryFileNames;
    property EntryStream: TStream read GetEntryStream;
  end;

implementation

resourcestring
  SInvalidFormat = 'The file is corrupt or of unknown type.';
  SFileNotFound = 'File "%s" doesn''t exist.';
  SCrcError = 'File "%s" is corrupt (CRC error).';

procedure CheckValidFormat(Condition: Boolean);
begin
  if not Condition then
    raise Exception.Create(SInvalidFormat);
end;

{ TZipReader }

procedure TZipReader.CloseEntry;
var
  Buffer: array [0..4095] of Byte;
begin
  Assert( FReading );
  Assert( FCurrentEntry <> nil );

  {$HINTS OFF}
  while FEntryStream.Read(Buffer, SizeOf(Buffer)) > 0 do
  {$HINTS ON}
    ;
  FreeAndNil(FCrc32Filter);
  FreeAndNil(FDecompressionStream);

  if FCrc32 <> FCurrentEntry.FHeader.Crc32 then
    raise Exception.CreateFmt(SCrcError, [FCurrentEntry.FFileName]);

  FreeAndNil(FRawEntryStream);
  FReading := FALSE;
end;

procedure TZipReader.Crc32FilterRead(Sender: TStream; const Buffer;
  Count: Integer);
begin
  FCrc32 := crc32(FCrc32, @Buffer, Count);
end;

constructor TZipReader.Create(Input: TStream);
var
  e: TZipEndDirectoryRecord;
  InputSize: Int64;
  DirBytesLeft, n: Integer;
  Entry: TZipEntry;
begin
  inherited Create;
  FEntries := TZipEntryList.Create;
  FInput := Input;
  InputSize := FInput.Size;
  CheckValidFormat(InputSize <= MaxInt);
  CheckValidFormat(InputSize >= SizeOf(e));
  FInput.Seek(InputSize - SizeOf(e), soFromBeginning);
  {$HINTS OFF}
  FInput.ReadBuffer(e, SizeOf(e));
  {$HINTS ON}

  CheckValidFormat(e.Signature = ZIP_END_DIRECTORY_RECORD_SIGNATURE);
  CheckValidFormat(e.DiskNumber = 0);
  CheckValidFormat(e.StartDirDiskNumber = 0);
  CheckValidFormat(e.DiskEntryCount = e.TotalEntryCount);
  CheckValidFormat(Int64(e.DirOffset) + Int64(e.DirSize) <= InputSize - SizeOf(e));
  CheckValidFormat(e.CommentLength = 0);

  FDirOffset := e.DirOffset;
  Input.Seek(e.DirOffset, soFromBeginning);
  DirBytesLeft := e.DirSize;
  while DirBytesLeft > 0 do
  begin
    Entry := TZipEntry.Create;
    FEntries.AddSafely(Entry);

    n := SizeOf(Entry.FHeader);
    CheckValidFormat(DirBytesLeft >= n);
    FInput.ReadBuffer(Entry.FHeader, n);
    CheckValidFormat(Entry.FHeader.Signature = ZIP_CENTRAL_FILE_HEADER_SIGNATURE);
    Dec(DirBytesLeft, n);

    n := Entry.FHeader.FileNameLength;
    CheckValidFormat(DirBytesLeft >= n);
    Entry.FFileName := ReadStreamFixedString(FInput, n);
    Dec(DirBytesLeft, n);

    n := Entry.FHeader.ExtraFieldLength + Entry.FHeader.FileCommentLength;
    CheckValidFormat(DirBytesLeft >= n);
    FInput.Seek(n, soFromCurrent);
    Dec(DirBytesLeft, n);
  end;
end;

destructor TZipReader.Destroy;
begin
  FreeAndNil(FCrc32Filter);
  FreeAndNil(FDecompressionStream);
  FreeAndNil(FRawEntryStream);
  FreeAndNil(FEntries);
  inherited;
end;

function TZipReader.FindEntryIndexByFileName(
  const FileName: String): Integer;
begin
  Result := GetEntryIndexByFileName(FileName);
  if Result = -1 then
    raise Exception.CreateFmt(SFileNotFound, [FileName]);
end;

function TZipReader.GetEntryCount: Integer;
begin
  Result := FEntries.Count;
end;

function TZipReader.GetEntryFileNames(Index: Integer): String;
begin
  Assert( Index >= 0 );
  Assert( Index < EntryCount );
  Result := FEntries[Index].FFileName;
end;

function TZipReader.GetEntryIndexByFileName(
  const FileName: String): Integer;

  function Scan(Left, Right: Integer): Integer;
  begin
    for Result := Left to Right do
      if SameText(FEntries[Result].FFileName, FileName) then
        Exit;
    Result := -1;
  end;

begin
  Result := Scan(FHotEntryIndex, EntryCount-1);
  if Result = -1 then
    Result := Scan(0, FHotEntryIndex-1);
  if Result <> -1 then
    FHotEntryIndex := Result;
end;

function TZipReader.GetEntryStream: TStream;
begin
  Assert( FReading );
  Result := FEntryStream;
end;

procedure TZipReader.OpenEntry(const FileName: String);
var
  Entry: TZipEntry;
  h: TZipLocalFileHeader;
  n: Integer;
begin
  Assert( not FReading );

  Entry := FEntries[FindEntryIndexByFileName(FileName)];
  CheckValidFormat(Entry.FHeader.CompressionMethod in [ZIP_METHOD_STORE, ZIP_METHOD_DEFLATE]);
  CheckValidFormat(Entry.FHeader.DiskNumberStart = 0);
  CheckValidFormat(Entry.FHeader.LocalHeaderOffset <= Int64(FDirOffset) - SizeOf(h));

  FInput.Seek(Entry.FHeader.LocalHeaderOffset, soFromBeginning);
  {$HINTS OFF}
  FInput.ReadBuffer(h, SizeOf(h));
  {$HINTS ON}
  CheckValidFormat(h.Signature = ZIP_LOCAL_FILE_HEADER_SIGNATURE);

  n := h.FileNameLength + h.ExtraFieldLength;
  CheckValidFormat(FInput.Position + n <= FDirOffset);
  FInput.Seek(n, soFromCurrent);
  CheckValidFormat(FInput.Position + Entry.FHeader.CompressedSize <= FDirOffset);

  FRawEntryStream := TInputFilterStream.Create(FInput, Entry.FHeader.CompressedSize);
  FEntryStream := FRawEntryStream;

  if Entry.FHeader.CompressionMethod = ZIP_METHOD_DEFLATE then
  begin
    FDecompressionStream := TDecompressionStream.Create(FEntryStream, TRUE);
    FEntryStream := FDecompressionStream;
  end;
  FCrc32Filter := TInputFilterStream.Create(FEntryStream);
  FEntryStream := FCrc32Filter;
  FCrc32Filter.OnRead := Crc32FilterRead;
  FCrc32 := crc32(0, nil, 0);

  FCurrentEntry := Entry;
  FReading := TRUE;
end;

{ TInputFilterStream }

constructor TInputFilterStream.Create(Source: TStream; const Limit: Int64 = -1);
begin
  inherited Create;
  FSource := Source;
  Assert( Limit >= -1 );
  FLimit := Limit;
end;

function TInputFilterStream.Read(var Buffer; Count: Integer): Longint;
begin
  if FLimit <> -1 then
    Count := Min(Count, FLimit - FBytesRead);
  Result := FSource.Read(Buffer, Count);
  if Assigned(FOnRead) then
    FOnRead(Self, Buffer, Result);
  Inc(FBytesRead, Result);
end;

function TInputFilterStream.Seek(const Offset: Int64;
  Origin: TSeekOrigin): Int64;
var
  SkipBytes: Int64;
  Buf: array [0..4095] of Byte;
  n: Integer;
begin
  if (Origin = soCurrent) and (Offset >= 0) then
    SkipBytes := Offset
  else if (Origin = soBeginning) and (Offset >= FBytesRead) then
    SkipBytes := Offset - FBytesRead
  else
    Assert( FALSE );

  while SkipBytes > 0 do
  begin
    n := Min(SkipBytes, SizeOf(Buf));
    {$HINTS OFF}
    ReadBuffer(Buf, n);
    {$HINTS ON}
    Dec(SkipBytes, n);
  end;

  Result := FBytesRead;
end;

procedure TInputFilterStream.SetSize(NewSize: Integer);
begin
  Assert( FALSE );
end;

{$WARNINGS OFF}
function TInputFilterStream.Write(const Buffer; Count: Integer): Longint;
begin
  Assert( FALSE );
end;
{$WARNINGS ON}

end.
